Delphi Informant Complete 1995 - 2000/Delphi Informant Complete 1995 to 2000.iso/Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar/1998/Jan/di9801rs/Sortalgs.pas

Pascal/Delphi Source File | 1997-08-20 | 5.9 KB | 212 lines

unit SortAlgs;

interface

uses
    Dialogs;

type
    ValueType = Longint; // Type used in the arrays.
    IndexType = Longint; // Type used to index arrays.
    TValueArray =  array[0..100000000] of ValueType;
    PValueArray = ^TValueArray;
    TCountArray =  array[0..100000000] of IndexType;
    PCountArray = ^TCountArray;

    procedure Bubblesort(var List : array of ValueType; min, max : IndexType);
    procedure Selectionsort(var List : array of ValueType; min, max : IndexType);
    procedure Quicksort(var List : array of ValueType; min, max : IndexType);
    procedure Countingsort(var List, SortedList : array of ValueType; min, max : IndexType; min_value, max_value : ValueType);

implementation

// Run bubblesort.
procedure Bubblesort(var List : array of ValueType; min, max : IndexType);
var
    last_swap, i, j : IndexType;
    tmp             : ValueType;
begin
    // Repeat until we are done.
    while (min < max) do
    begin
        // Bubble up.
        last_swap := min - 1;
        // for i := min + 1 to max
        i := min + 1;
        while (i <= max) do
        begin
            // Find a bubble.
            if (List[i - 1] > List[i]) then
            begin
                // See where to drop the bubble.
                tmp := List[i - 1];
                j := i;
                repeat
                    List[j - 1] := List[j];
                    j := j + 1;
                    if (j > max) then Break;
                until (List[j] >= tmp);
                List[j - 1] := tmp;
                last_swap := j - 1;
                i := j + 1;
            end else
                i := i + 1;
        end; // while (i <= max) do.
        // End bubbling up.

        // Update max.
        max := last_swap - 1;

        // Bubble down.
        last_swap := max + 1;
        // for i := max - 1 downto min
        i := max - 1;
        while (i >= min) do
        begin
            // Find a bubble.
            if (List[i + 1] < List[i]) then
            begin
                // See where to drop the bubble.
                tmp := List[i + 1];
                j := i;
                repeat
                    List[j + 1] := List[j];
                    j := j - 1;
                    If j < min Then Break;
                until (List[j] <= tmp);
                List[j + 1] := tmp;
                last_swap := j + 1;
                i := j - 1;
            end else
                i := i - 1;
        end; // while (i >= min) do
        // End bubbling down.

        // Update min.
        min := last_swap + 1;
    end; // while (min < max) do
end;

// Run selectionsort.
procedure Selectionsort(var List : array of ValueType; min, max : IndexType);
var
    i, j, best_j : IndexType;
    best_value   : ValueType;
begin
    for i := min to max - 1 do
    begin
        best_value := List[i];
        best_j := i;
        for j := i + 1 to max do
        begin
            if (List[j] < best_value) Then
            begin
                best_value := List[j];
                best_j := j;
            end;
        end;    // for j := i + 1 to max do
        List[best_j] := List[i];
        List[i] := best_value;
    end;        // for i := min to max - 1 do
end;

// Run quicksort.
procedure Quicksort(var List : array of ValueType; min, max : IndexType);
var
    med_value : ValueType;
    hi, lo, i : IndexType;
begin
    // If the list has <= 1 element, it's sorted.
    if (min >= max) then Exit;

    // Pick a dividing item randomly.
    i := min + Trunc(Random(max - min + 1));
    med_value := List[i];

    // Swap it to the front so we can find it easily.
    List[i] := List[min];

    // Move the items smaller than this into the left
    // half of the list. Move the others into the right.
    lo := min;
    hi := max;
    while (True) do
    begin
        // Look down from hi for a value < med_value.
        while (List[hi] >= med_value) do
        begin
            hi := hi - 1;
            if (hi <= lo) then Break;
        end;
        if (hi <= lo) then
        begin
            // We're done separating the items.
            List[lo] := med_value;
            Break;
        end;

        // Swap the lo and hi values.
        List[lo] := List[hi];

        // Look up from lo for a value >= med_value.
        lo := lo + 1;
        while (List[lo] < med_value) do
        begin
            lo := lo + 1;
            if (lo >= hi) then Break;
        end;
        if (lo >= hi) then
        begin
            // We're done separating the items.
            lo := hi;
            List[hi] := med_value;
            Break;
        end;

        // Swap the lo and hi values.
        List[hi] := List[lo];
    end; // while (True) do

    // Sort the two sublists.
    Quicksort(List, min, lo - 1);
    Quicksort(List, lo + 1, max);
end;

// Run countingsort.
procedure Countingsort(var List, SortedList : array of ValueType; min, max : IndexType; min_value, max_value : ValueType);
var
    i, j, next_index : IndexType;
    count_index      : ValueType;
    counts           : PCountArray;
begin
    // Create the Counts array.
    GetMem(counts, (max_value - min_value + 1) * SizeOf(IndexType));

    // Initialize the counts to zero.
    for i := 0 to max_value - min_value do
        counts[i] := 0;

    // Count the items.
    for i := min to max do
    begin
        count_index := List[i] - min_value;
        counts[count_index] := counts[count_index] + 1;
    end;

    // Place the items in the sorted array.
    next_index := min;
    for i := min_value to max_value do
    begin
         for j := 1 to counts[i - min_value] do
         begin
             SortedList[next_index] := i;
             next_index := next_index + 1;
         end;
    end;

    // Free the memory allocated for the counts array.
    FreeMem(counts);
end;

end.